Data

This section illustrates how to access data, and defines helper methods to filter, map, summarise, and plot data.

Once refined, these helper functions will become core wastdr functionality.

Caveat

• The data as shown is still pre-QA until this message disappears.
• Usernames are still hilariously wrong after matching the usernames (as submitted) to the actual usernames in WAStD. See the field commments for QA messages.

Load data

if (file.exists("~/tracks.Rda")){
    load("~/tracks.Rda")
} else {
    track_records <- wastdr::get_wastd("turtle-nest-encounters")
    save(track_records, file = "~/track_records.Rda")
    load("~/track_records.Rda")
    # listviewer::jsonedit(utils::head(track_records$features))
    tracks <- parse_turtle_nest_encounters(track_records)
    save(tracks, file = "~/tracks.Rda")
}

Filter data

To filter records to one area, we can either filter by area or site ID (once enabled), or simply filter by a bounding box. Additionaly, we’ll filter by date.

In this example, we’ll filter to an area surveyed by the West Pilbara Turtle Program.

species_colours <- tibble::tibble(
    species = c(
    "cheloniidae-fam",
    "chelonia-mydas",
    "eretmochelys-imbricata",
    "natator-depressus",
    "corolla-corolla",
    "lepidochelys-olivacea",
    "caretta-caretta"    
    ),
    species_colours = c(
    "gray",
    "green",
    "darkblue",
    "beige",
    "pink",
    "darkgreen",
    "orange"
    )
)

nest_type_text <- tibble::tibble(
    nest_type = c(
        "hatched-nest", 
        "successful-crawl",
        "track-not-assessed",
        "track-unsure",
        "nest",
        "false-crawl"),
    nest_type_text = c(
        "NH", 
        "N",
        "T+?",
        "N?",
        "N",
        "T")
)


add_lookups <- . %>% 
    left_join(species_colours, by="species") %>%
    left_join(nest_type_text, by="nest_type")

filter_2017 <- . %>% dplyr::filter(date > dmy("17/11/2017")) %>% add_lookups
filter_broome <- . %>% dplyr::filter(area_name=="Cable Beach Broome")
filter_eighty_mile_beach <- . %>% dplyr::filter(area_name=="Eighty Mile Beach Caravan Park")
filter_anna_plains <- . %>% dplyr::filter(area_name=="Anna Plains")
filter_port_hedland <- . %>% dplyr::filter(site_name=="Port Hedland Turtle Nesting Beaches")
filter_west_pilbara <- . %>% dplyr::filter(area_name=="Karratha / Burrup")
filter_thevenard <- . %>% dplyr::filter(area_name=="Thevenard Island")

Map data

tracks_map <- function(track_data) {
    l <- leaflet(width=800, height=600) %>% 
        addProviderTiles("Esri.WorldImagery", group = "Aerial") %>%
        addProviderTiles("OpenStreetMap.Mapnik", group = "Place names") %>%
        clearBounds()

    tracks.df <-  track_data %>% split(track_data$species)
    
    names(tracks.df) %>%
        purrr::walk( function(df) {
            l <<- l %>%
                addAwesomeMarkers(
                    data = tracks.df[[df]],
                    lng = ~longitude, lat=~latitude,
                    icon = leaflet::makeAwesomeIcon(
                        text = ~nest_type_text,
                        markerColor = ~species_colours),
                    label=~paste(date, nest_age, species, nest_type, name),
                    popup=~paste(date, nest_age, species, nest_type, name),
                    group = df
                )
        })
    
    l %>%
        addLayersControl(
            baseGroups = c("Aerial", "Place names"),
            overlayGroups = names(tracks.df),
            options = layersControlOptions(collapsed = FALSE)
        )
}

Summarise and plot data

Data (all tracks or filtered subsets) are filtered to only fresh observations, then grouped and tallied by date, species and type.

Daily summaries are shown in wide form as tables, and (using long form) as timeseries plots.

daily_species_by_type <- . %>% 
    filter(nest_age=="fresh") %>%
    group_by(date, species, nest_type) %>% 
    tally() %>%
    ungroup()

daily_summary <- . %>% 
    daily_species_by_type %>% 
    tidyr::spread(nest_type, n, fill=0) %>%
    DT::datatable(.)

tracks_ts <- . %>% 
    daily_species_by_type %>% 
    {ggplot2::ggplot(data=., aes(x = date, y = n, colour = nest_type)) + 
            ggplot2::geom_point() + 
            ggplot2::geom_smooth(method = "auto") +
            # ggplot2::geom_line() +
            ggplot2::scale_x_date(breaks = scales::pretty_breaks(),
                                  labels = scales::date_format("%d %b %Y")) +
            ggplot2::xlab("Date") +
            ggplot2::ylab("Number counted per day") +
            ggplot2::ggtitle("Nesting activity") +
            ggplot2::theme_light()}

Nesting activity

This chapter uses the data and helpers from the above section and provides some insight into the different regions.

This section is by no means complete and can be extended as appropriate.

Overall

tracks %>% add_lookups %>% tracks_map

Broome Cable Beach

tracks_cbb <- tracks %>% filter_2017 %>% filter_broome
tracks_cbb %>% tracks_map

tracks_cbb %>% DT::datatable(.)

tracks_cbb %>% daily_summary

tracks_cbb %>% tracks_ts
#> `geom_smooth()` using method = 'loess'
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : span too small. fewer data values than degrees of freedom.
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : pseudoinverse used at 17496
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : neighborhood radius 20.21
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : reciprocal condition number 0
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : There are other near singularities as well. 493.28
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : span too small.
#> fewer data values than degrees of freedom.
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : pseudoinverse used
#> at 17496
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : neighborhood radius
#> 20.21
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : reciprocal
#> condition number 0
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : There are other
#> near singularities as well. 493.28
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : span too small. fewer data values than degrees of freedom.
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : pseudoinverse used at 17498
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : neighborhood radius 11.16
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : reciprocal condition number 0
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : There are other near singularities as well. 447.75
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : span too small.
#> fewer data values than degrees of freedom.
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : pseudoinverse used
#> at 17498
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : neighborhood radius
#> 11.16
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : reciprocal
#> condition number 0
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : There are other
#> near singularities as well. 447.75

named_nests_cbb <- tracks_cbb %>% filter(!(is.na(name)))
named_nests_cbb %>% tracks_map

named_nests_cbb %>% DT::datatable(.)

Anna Plains

tracks_ap <- tracks %>% filter_2017 %>% filter_anna_plains
tracks_ap %>% tracks_map

tracks_ap %>% DT::datatable(.)

tracks_ap %>% daily_summary

tracks_ap %>% tracks_ts
#> `geom_smooth()` using method = 'loess'

Eighty Mile Beach

tracks_emb <- tracks %>% filter_2017 %>% filter_eighty_mile_beach
tracks_emb %>% tracks_map

tracks_emb %>% DT::datatable(.)

tracks_emb %>% daily_summary

tracks_emb %>% tracks_ts
#> `geom_smooth()` using method = 'loess'
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : pseudoinverse used at 17496
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : neighborhood radius 7.05
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : reciprocal condition number 2.3619e-17
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : There are other near singularities as well. 49.702
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : pseudoinverse used
#> at 17496
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : neighborhood radius
#> 7.05
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : reciprocal
#> condition number 2.3619e-17
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : There are other
#> near singularities as well. 49.702

Port Hedland

tracks_pth <- tracks %>% filter_2017 %>% filter_port_hedland
tracks_pth %>% tracks_map

tracks_pth %>% DT::datatable(.)

tracks_pth %>% daily_summary

tracks_pth %>% tracks_ts
#> `geom_smooth()` using method = 'loess'

# named_nests_pth <- tracks_pth %>% filter(!(is.na(name)))
# named_nests_pth %>% tracks_map
# named_nests_pth %>% DT::datatable(.)

West Pilbara Turtle Program

tracks_wp <- tracks %>% filter_2017 %>% filter_west_pilbara
tracks_wp %>% tracks_map

tracks_wp %>% DT::datatable(.)

tracks_wp %>% daily_summary

tracks_wp %>% tracks_ts
#> `geom_smooth()` using method = 'loess'
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : span too small. fewer data values than degrees of freedom.
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : pseudoinverse used at 17494
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : neighborhood radius 15.085
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : reciprocal condition number 0
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : There are other near singularities as well. 4.3472
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : span too small.
#> fewer data values than degrees of freedom.
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : pseudoinverse used
#> at 17494
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : neighborhood radius
#> 15.085
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : reciprocal
#> condition number 0
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : There are other
#> near singularities as well. 4.3472

Thevenard Island

tracks_thv <- tracks %>% filter_2017 %>% filter_thevenard
tracks_thv %>% tracks_map

tracks_thv %>% DT::datatable(.)
#> Warning in instance$preRenderHook(instance): It seems your data is too
#> big for client-side DataTables. You may consider server-side processing:
#> http://rstudio.github.io/DT/server.html

tracks_thv %>% daily_summary

tracks_thv %>% tracks_ts
#> `geom_smooth()` using method = 'loess'
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : span too small. fewer data values than degrees of freedom.
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : pseudoinverse used at 17499
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : neighborhood radius 2.045
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : reciprocal condition number 0
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : There are other near singularities as well. 49.632
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : span too small.
#> fewer data values than degrees of freedom.
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : pseudoinverse used
#> at 17499
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : neighborhood radius
#> 2.045
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : reciprocal
#> condition number 0
#> Warning in predLoess(object$y, object$x, newx = if
#> (is.null(newdata)) object$x else if (is.data.frame(newdata))
#> as.matrix(model.frame(delete.response(terms(object)), : There are other
#> near singularities as well. 49.632
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : span too small. fewer data values than degrees of freedom.
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : at 17506
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : radius 2.5e-05
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : all data on boundary of neighborhood. make span bigger
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : pseudoinverse used at 17506
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : neighborhood radius 0.005
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : reciprocal condition number 1
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : at 17507
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : radius 2.5e-05
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : all data on boundary of neighborhood. make span bigger
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : There are other near singularities as well. 2.5e-05
#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : zero-width neighborhood. make span bigger

#> Warning in simpleLoess(y, x, w, span, degree = degree, parametric =
#> parametric, : zero-width neighborhood. make span bigger
#> Warning: Computation failed in `stat_smooth()`:
#> NA/NaN/Inf in foreign function call (arg 5)